home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-11 / tagbr.zip / TAGBROW.PRG < prev    next >
Text File  |  1993-04-22  |  5KB  |  147 lines
  1. /*
  2.   ┌──────────────────────────────────────────────────────────────────────────┐
  3.   │  Application: Example of a tagging browse object                         │
  4.   │    File Name: TAGBROW.PRG                                                │
  5.   │       Author: Nicholas Solomon                                           │
  6.   └──────────────────────────────────────────────────────────────────────────┘
  7. */
  8.  
  9. #include "inkey.ch"
  10. #include "tagbrow.ch"
  11. /*
  12.   ┌──────────────────────────────────────────────────────────────────────────┐
  13.   │     Function: TAGBROW()                                                  │
  14.   ├──────────────────────────────────────────────────────────────────────────┤
  15.   │  Description: allow user a taggable browse pick object                   │
  16.   │       Params: cFieldName   =  Name of field used for selection           │
  17.   │                 cColName   =  Column header for above col. object        │
  18.   │                     nTop   =  top row of object                          │
  19.   │                    nLeft   =  left col of object                         │
  20.   │                 lMessage   =  .t. = include message (default to .t.)     │
  21.   │                   cTitle   =  title a box around the object              │
  22.   │       Return: (aSelected) = record numbers of selected items             │
  23.   └──────────────────────────────────────────────────────────────────────────┘
  24. */
  25. function tagbrow( cFieldName, cColName, nTop, nLeft, lMessage, cTitle)
  26.     local tb_methods := { ;
  27.                    {K_DOWN,       {|b| b:down()}}, ;
  28.                    {K_UP,         {|b| b:up()}}, ;
  29.                         {K_CTRL_PGUP,    {|b| b:gotop() }},;
  30.                         {K_CTRL_PGDN,    {|b| b:gobottom() }},;
  31.                    {K_PGDN,       {|b| b:pagedown()}}, ;
  32.                    {K_PGUP,       {|b| b:pageup()}}, ;
  33.                    {K_HOME,       {|b| b:gotop()}}, ;
  34.                    {K_END,        {|b| b:gobottom()}} }
  35.     local meth_no, column, aSelected:={}
  36.     local b,exit_request:=.f.,lkey,skey:="", nFound, cOldColor:=setcolor()
  37.     local nLenField, bSelect, cScreen:=savescreen(0,0,maxrow(),maxcol())
  38.     local bField := fieldblock( cFieldName )
  39.  
  40.     DEFAULT cColName TO cFieldName
  41.     DEFAULT lMessage TO .t.
  42.  
  43.     /* get length of browse field to determine width of browse screen */
  44.     nLenField := len(eval(bField))
  45.  
  46.     /* build a box if cTitle was passed - could be done better! */
  47.     if cTitle != NIL
  48.         @ nTop-1, nLeft-1 to maxrow()-3, nLeft + nLenField+1 color 'W/B'
  49.         @ nTop-1, ( nLeft + ( int( (nLeft + nLenField) - (nLeft-1) ) / 2 ) ) - ;
  50.                      ( int( len(cTitle)  / 2 ) ) - 1 say '┤' + cTitle + '├' ;
  51.                      color 'RB+/B'
  52.     endif
  53.  
  54.     /* declare browse object */
  55.     b := TBrowseDB( nTop, nLeft , maxrow()-4, nLeft+nLenField )
  56.     b:headsep := "═══"
  57.     b:footsep := "═══"
  58.     b:colorspec := "W/B,N/W,R+/B,R+/W,W+/B,W/N,N/W"
  59.     /*
  60.         the first column MUST be the array for
  61.         selected (tagged) record numbers
  62.     */
  63.     column := TBColumnNew( ' ',;
  64.         {|| iif( ascan( aSelected, recno() ) !=0,;
  65.                  CHECKMARK,' ') } )
  66.     column:width:=1
  67.     column:defColor   := { 3, 3 }
  68.     column:colorBlock := {|| { 5, 5 } }
  69.     b:addColumn( column )
  70.     /*
  71.         block to highlight selected vs. unselected items
  72.     */
  73.     bSelect := {|| iif( ascan( aSelected, recno() ) != 0,;
  74.                     { 3, 4 } , { 1, 2 } ) }
  75.     column := TBColumnNew( cColName, bField )
  76.     column:defColor   := { 3,3}
  77.     column:colorBlock := bSelect
  78.     b:addColumn( column )
  79.     /*
  80.         freeze the first column - don't allow them to go into it
  81.     */
  82.     b:freeze := 1
  83.     dispbegin()
  84.     do while !b:stabilize()   ;  enddo
  85.     dispend()
  86.     do while !exit_request
  87.         /* keep 'em out of first column */
  88.         if b:colPos <= b:freeze
  89.             b:colPos := b:freeze + 1
  90.         endif
  91.         do while nextkey() = 0 .and. !b:stabilize() ; enddo
  92.         lkey = inkey( 0)
  93.         meth_no = ascan( tb_methods,{|elem| lkey = elem[1]})
  94.         if meth_no != 0
  95.               eval( tb_methods[meth_no,2],b)
  96.         else
  97.               do case
  98.                 /* deletes ALL selections */
  99.                 case lkey == K_DEL
  100.                     aSelected:={}
  101.                     if lMessage
  102.                         @ maxrow(),0 say padc('You have selected '+alltrim(str(len(aSelected))) + ;
  103.                                 ' ' + iif(len(aSelected)=1,'item','items'), maxcol())
  104.                     endif
  105.                     b:refreshall()
  106.  
  107.                 /* select-unselect element */
  108.                 case lkey == K_ENTER
  109.                     if ( (nFound:=ascan(aSelected, recno() )) != 0 )
  110.                         adel(aSelected, nFound)
  111.                         asize(aSelected, (len(aSelected)-1))
  112.                     else
  113.                         aadd(aSelected, recno() )
  114.                     endif
  115.                     /* simply inform user how many are selected */
  116.                     if lMessage
  117.                         @ maxrow(),0 say padc('You have selected '+alltrim(str(len(aSelected))) + ;
  118.                                 ' ' + iif(len(aSelected)=1,'item','items'), maxcol())
  119.                     endif
  120.                     b:refreshcurrent()
  121.  
  122.                  case lkey = K_ESC
  123.                     exit_request = .T.
  124.  
  125.                 /* 
  126.                     this simply allows user to jump 
  127.                     as alpha keys are typed -- 
  128.                     not much good in this example !
  129.                 */
  130.                 case ( lkey > 47 .and. lkey < 123) .or. ;
  131.                         lkey = 32 .or. lkey = 39
  132.                      if ! dbseek( upper( chr( lkey)))
  133.                         dbgotop()
  134.                      endif
  135.                      b:refreshall()
  136.  
  137.               endcase
  138.         endif
  139.     enddo
  140.     setcolor( cOldColor )
  141.     restscreen(0,0,maxrow(),maxcol(), cScreen)
  142. return(aSelected)
  143.  
  144.  
  145.  
  146.  
  147.